home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 001a / com_and3.zip / REMAP.CMD < prev    next >
OS/2 REXX Batch file  |  1990-10-10  |  28KB  |  1,167 lines
  1. ; ----- COM-AND Compile remap table
  2. ;
  3. ;    This script opens a window asking 1) to compile new remap, 2) turn
  4. ;    remapping on, and 3) turn remap off.
  5. ;
  6. ;    The big job, of course, if the compilation of remapping values.
  7. ;    The result of the compilation os saved in COM-AND.RMP.
  8. ;
  9. ;    R.McG, commenced 2/89
  10. ; ----- Usages -----------------
  11. ;    S19 -----> COM-AND.RMP file name to be used
  12. ;    S18 -----> Source file being compiled
  13. ;    N99 -----> The # of errors in compilation
  14. ;    N98 -----> The output file size
  15. ;    N97 -----> # name commands to allow (set in SELECT)
  16. ;    FLAG(9) -> Escape during compile (wait for another ESC)
  17. ;    FLAG(8) -> If true, syntax check only
  18. ; ------------------------------
  19. ;    Initialization
  20. ;
  21. ;* TRACE ON
  22.    ON ESCAPE GOSUB Exit         ; SAVE is performed in Window
  23.    LEGEND " Define remap (ver 1.2)"
  24.    SET TTHRU OFF            ; Disallow typeahead
  25.    GOSUB Set_Fname            ; Get current fname
  26.    UPPER S19                ; Make nice for display
  27.    S17 = "\PE.EXE"                      ; Set your editor here
  28. ;
  29. ;    Open a window
  30. ;
  31.    GOSUB Window             ; Open main window
  32. ;
  33. ;    Wait for a keystroke
  34. ;
  35. Keyin:
  36.    LOCATE 18,20
  37.    ATSAY  18,20 (default) "   "
  38.    KEYGET S0
  39.    IF NULL S0(1:3)
  40.       ATSAY 18,20 (default) S0
  41.       ENDIF
  42. ;
  43. ;    Interpret the response
  44. ;
  45.    SWITCH S0
  46.       CASE "1"                                  ; Compile
  47.     GOSUB Compile
  48.       ENDCASE
  49.       CASE "2"                                  ; Syntax
  50.     GOSUB Syntax
  51.       ENDCASE
  52.       CASE "3"                                  ; Search for file
  53.     GOSUB Alt_F
  54.       ENDCASE
  55.       CASE "4"                                  ; Edit a file
  56.     GOSUB Edit
  57.       ENDCASE
  58.       CASE "5"                                  ; Remap on
  59.     GOSUB Mapon
  60.       ENDCASE
  61.       CASE "6"                                  ; Remap off
  62.     GOSUB Mapoff
  63.       ENDCASE
  64.       DEFAULT                    ; None of the above
  65.      SOUND 100,100
  66.      GOTO Keyin                ; Try again
  67.       ENDCASE
  68.    ENDSWITCH
  69.    GOTO KEYIN
  70. ;
  71. ; ----- Subroutine Exit - terminate the process
  72. ;
  73. Exit:
  74.     DO                ; CLose any open windows
  75.       WCLOSE
  76.       UNTIL FAILURE
  77.     EXIT
  78. ;
  79. ; ----- Subroutine Mapon - turn on mapping (using current file)
  80. ;
  81. MapOn:
  82.     SET REMAP ON            ; Enable
  83.     RETURN
  84. ;
  85. ; ----- Subroutine MapOff - turn off mapping
  86. ;
  87. MapOff:
  88.     SET REMAP OFF            ; Disable
  89.     RETURN
  90. ;
  91. ; ----- Perform an Alt-F - file search
  92. ;
  93. Alt_F:
  94.     WOPEN 10,1  13,78 (default) ErrEsc
  95.     ATSAY 10,3  (default) " Search for files "
  96.     ATSAY 11,3  (default) "Enter a search template (e.g. 'd:\subd\x*.AR?')."
  97.     ATSAY 12,3  (default) "-> "
  98.     ATSAY 13,30 (default) " Press ESC to cancel "
  99.     ATGET 12,6  (default) 50 S0
  100.     WCLOSE
  101. ;
  102. ;    If not null, perform the request
  103. ;
  104.     IF NOT NULL S0
  105.        DIR S0                ; Make upper case
  106.        ENDIF
  107.     RETURN
  108. ;
  109. ; ----- Invoke an editor to edit a file
  110. ;
  111. Edit:
  112.     IF NOT NULL S17             ; Only ask once
  113.        GOTO Edit100
  114.        ENDIF
  115. ;
  116. ;    Open a window and ask for the editor's name
  117. ;
  118.     WOPEN 10,1  13,78 (default) ErrEsc
  119.     ATSAY 10,3  (default) " Edit file "
  120.     ATSAY 11,3  (default) "Enter the editor's name, fully qualified (e.g. C:\PE.EXE)."
  121.     ATSAY 12,3  (default) "-> "
  122.     ATSAY 13,30 (default) " Press ESC to cancel "
  123.     ATGET 12,6  (default) 50 S0        ; ErrEsc clears S0, so we use it
  124.     WCLOSE
  125.  
  126.     IF NULL S0                ; Return on empry answer
  127.        RETURN
  128.        ENDIF
  129.     S17 = S0
  130. ;
  131. ;    Open another window and ask for the file name
  132. ;
  133. Edit100:
  134.     WOPEN 10,1  13,78 (default) ErrEsc
  135.     ATSAY 10,3  (default) " Edit file "
  136.     ATSAY 11,3  (default) "Enter the file name to be edited:"
  137.     ATSAY 12,3  (default) "-> "
  138.     ATSAY 13,30 (default) " Press ESC to cancel "
  139.     ATGET 12,6  (default) 50 S0        ; ErrEsc clears S0, so we use it
  140.     WCLOSE
  141. ;
  142. ;    If not null, perform the request
  143. ;
  144.     IF NOT NULL S0
  145.        RUN S17 * " " *S0                    ; Make upper case
  146.        IF FAILED
  147.           S17 = ""                          ; Clear S17 if failed
  148.           ENDIF
  149.        ENDIF
  150.     RETURN
  151. ;
  152. ; ----- Construct the file name we'll use for COM-AND.RMP
  153. ;
  154. Set_Fname:
  155.     S19 = "COM-AND.RMP"     ; Default to current subdir
  156.     IF ISFILE S19        ; Look for file on default subdir
  157.        RETURN        ; Exit here
  158.        ENDIF
  159. ;
  160. ; ----- Construct the file with the COM-AND= pathing (if provided)
  161. ;
  162.     ENVIRON S1 "COM-AND="   ; Look for COM-AND= environment var
  163.     IF FOUND        ; If environment variable found
  164.        LENGTH S1 N0     ; Get its length
  165.        N0 = N0-1        ; Point to last char in string
  166.        IF not STRCMP S1(n0:n0) "\"
  167.           N0 = N0+1
  168.           CONCAT S1(n0) "\"
  169.           ENDIF
  170.        ENDIF
  171.     S19 = S1&"COM-AND.RMP"  ; Concatenate path and name
  172.     RETURN
  173. ;
  174. ; ----- Subroutine: error
  175. ;    .. Open a window, display, and and await keypress
  176. ;    S0,S1 pass the message(s) to display
  177. ;
  178. Error:
  179.     WOPEN 10,1, 13,77 (contrast) ErrEsc
  180.     ATSAY 11, 3 (contrast) S0(0:73)
  181.     ATSAY 12, 3 (contrast) S1(0:73)
  182.     ATSAY 13,26 (contrast) " Press any key to continue "
  183.     SOUND 880,100
  184.  
  185.     KEYGET S0        ; Wait for any key
  186.     WCLOSE            ; Restore screen under
  187.     RETURN            ; And return to caller
  188. ;
  189. ;    Escape during "Error" window
  190. ;
  191. ErrEsc:
  192.     S0 = ""                 ; Make S0 null
  193.     RETURN            ; And return to KEYGET above
  194. ;
  195. ; ----- Subroutine: Test S0 for a valid (known) keycode
  196. ;    Parameter S0 ------> The keycode being passed
  197. ;    Return:   FLAG(0) <- TRUE if erroneous keycode
  198. ;          S0 <------ The converted keycode (if FLAG(0) false)
  199. ;          N0 <------ The length of the converted keycode
  200. ;
  201. Keycode:
  202.     LJ S0            ; Force left justification
  203.     S0 = S0&""              ; Trim trailing blanks
  204.     SET FLAG(0) OFF     ; Default return value
  205.     LENGTH S0 N0        ; Compute len of parm
  206. ;
  207. ;    Catch decimal and hex numbers here
  208. ;
  209.     IF NUMERIC S0(0:0)    ; Case insensitive test here
  210.        ATOI S0 N0        ; Convert value
  211.        IF (NOT ERROR) and (GE N0 0 and LE N0 255)
  212.           ITOC N0 S0    ; Return value 0-255 as char
  213.           N0 = 1        ; Set rtn length
  214.           RETURN
  215.           ENDIF
  216.        ENDIF
  217. ;
  218. ;    Switch according to length here
  219. ;
  220.     SWITCH N0
  221.        CASE 1        ; 1 char wide
  222.          GOTO TEKE100
  223.        ENDCASE
  224.        CASE 2        ; 2 chars wide
  225.          GOTO TEKE200
  226.        ENDCASE
  227.        CASE 3        ; 3 chars wide
  228.          GOTO TEKE300
  229.        ENDCASE
  230.        CASE 4        ; 4 chars wide
  231.          GOTO TEKE400
  232.        ENDCASE
  233.        CASE 5        ; 5 chars wide
  234.          GOTO TEKE500
  235.        ENDCASE
  236.        CASE 6        ; 6 chars wide
  237.          GOTO TEKE600
  238.        ENDCASE
  239.        DEFAULT
  240.           SET FLAG(0) ON    ; Others are errors
  241.           RETURN
  242.        ENDCASE
  243.     ENDSWITCH
  244. ;
  245. ; ***** Single character keycode here (take char as-is)
  246. ;
  247. TEKE100:
  248.     N0 = 1            ; Return length here (char already in S0)
  249.     RETURN
  250. ;
  251. ; ***** Two character keycode here: First: ^chars
  252. ;
  253. TEKE200:
  254.     IF STRCMP S0(0:0) "^"   ; Caret initially
  255.        UPPER S0        ; Make upper case
  256.        CTOI S0(1:1) N0
  257.        ITOC (N0-64) S0    ; Convert to control form, and place
  258.        N0 = 1
  259.        RETURN
  260.        ENDIF
  261. ;
  262. ;    Catch F0-F9
  263. ;
  264.     IF FIND "F1,F2,F3,F4,F5,F6,F7,F8,F9" S0 N0
  265.        IF NE 0 (N0\3)    ; Modulo divide (remainder)
  266.           SET FLAG(0) ON    ; .. catch e.g. "0,"
  267.           RETURN
  268.           ENDIF
  269.        ITOC 0 S0
  270.        ITOC (0x3b+N0/3) S0(1)
  271.        N0 = 2
  272.        RETURN
  273.        ENDIF
  274. ;
  275. ;    Catch cr and bs here
  276. ;
  277.     SWITCH S0
  278.        CASE "CR"            ; Carriage Rtn
  279.           ITOC 13 S0
  280.           N0 = 1
  281.           RETURN
  282.        ENDCASE
  283.        CASE "BS"            ; Carriage Rtn
  284.           ITOC 8 S0
  285.           N0 = 1
  286.           RETURN
  287.        ENDCASE
  288.     ENDSWITCH
  289. ;
  290. ;    Other pairs are errors
  291. ;
  292.     SET FLAG(0) ON        ; Others are errors
  293.     RETURN
  294. ;
  295. ; ***** Three character keycode here: First, rtn a quoted character
  296. ;
  297. TEKE300:
  298.     IF STRCMP S0(0:0) "`"" and STRCMP S0(2:2) "`""
  299.        S0 = S0(1:1)
  300.        N0 = 1        ; Return length here (char in S0)
  301.        RETURN
  302.        ENDIF
  303. ;
  304. ;    Catch SF0-SF9, CF0-CF9, AF0-AF9, ^F0-^F9
  305. ;
  306.     UPPER S0
  307.     IF FIND "F1,F2,F3,F4,F5,F6,F7,F8,F9" S0(1:2) N0
  308.        IF NE (N0\3) 0    ; Modulo divide (remainder)
  309.           SET FLAG(0) ON    ; .. catch e.g. "0,"
  310.           RETURN
  311.           ENDIF
  312.     ;
  313.     ;    Look at the leading character
  314.     ;
  315.        FIND "SCA^" S0(0:0) N1
  316.        SWITCH N1
  317.           CASE 0        ; AF0,AF1...
  318.         ITOC (0x54+N0/3) S0(1)
  319.           ENDCASE
  320.           CASE 1        ; CF0,CF1...
  321.         ITOC (0x5E+N0/3) S0(1)
  322.           ENDCASE
  323.           CASE 2        ; AF0,AF1...
  324.         ITOC (0x68+N0/3) S0(1)
  325.           ENDCASE
  326.           CASE 3        ; ^F0,^F1...
  327.         ITOC (0x5E+N0/3) S0(1)
  328.           ENDCASE
  329.           DEFAULT
  330.         SET FLAG(0) ON
  331.         RETURN
  332.           ENDCASE
  333.        ENDSWITCH
  334.     ;
  335.     ;    Return with the goods
  336.     ;
  337.        ITOC 0 S0        ; Modify S) after look for "SCA^"
  338.        N0 = 2
  339.        RETURN
  340.        ENDIF
  341. ;
  342. ;    And finally, 'END','ESC', 'TAB' and 'F10'
  343. ;
  344.     SWITCH S0
  345.        CASE "END"           ; Endkey
  346.           ITOC 0x4f S0(1)
  347.           ITOC 0 S0
  348.           N0 = 2
  349.           RETURN
  350.        ENDCASE
  351.        CASE "TAB"           ; Tabkey
  352.           ITOC 9 S0
  353.           N0 = 1
  354.           RETURN
  355.        ENDCASE
  356.        CASE "ESC"           ; Esckey
  357.           ITOC 0x1b S0
  358.           N0 = 1
  359.           RETURN
  360.        ENDCASE
  361.        CASE "F10"           ; F10 key
  362.           ITOC 0x44 S0(1)
  363.           ITOC 0 S0
  364.           N0 = 2
  365.           RETURN
  366.        ENDCASE
  367.        CASE "INS"           ; Inskey
  368.           ITOC 0x52 S0(1)
  369.           ITOC 0 S0
  370.           N0 = 2
  371.           RETURN
  372.        ENDCASE
  373.        CASE "DEL"           ; Delkey
  374.           ITOC 0x53 S0(1)
  375.           ITOC 0 S0
  376.           N0 = 2
  377.           RETURN
  378.        ENDCASE
  379.     ENDSWITCH
  380. ;
  381. ;    Others are errors
  382. ;
  383.     SET FLAG(0) ON        ; Others are errors
  384.     RETURN
  385. ;
  386. ; ***** Four character keycode here
  387. ;
  388. TEKE400:
  389. ;
  390. ;    Catch AltA-AltZ, Alt0-Alt9, Alt-
  391. ;
  392.     UPPER S0
  393.     IF FIND "ALT" S0(0:2)   ; Case insensitive test
  394.     ;
  395.     ;    Catch Alt'd QWERTYUIOP
  396.     ;
  397.        IF FIND "QWERTYUIOP" S0(3) N0
  398.           ITOC (0x10+N0) S0(1)
  399.           ITOC 0 S0
  400.           N0 = 2
  401.           RETURN
  402.           ENDIF
  403.     ;
  404.     ;    Catch Alt'd ASDFGHJKL
  405.     ;
  406.        IF FIND "ASDFGHJKL" S0(3) N0
  407.           ITOC (0x1E+N0) S0(1)
  408.           ITOC 0 S0
  409.           N0 = 2
  410.           RETURN
  411.           ENDIF
  412.     ;
  413.     ;    Catch Alt'd ZXCVBNM
  414.     ;
  415.        IF FIND "ZXCVBNM" S0(3) N0
  416.           ITOC (0x2C+N0) S0(1)
  417.           ITOC 0 S0
  418.           N0 = 2
  419.           RETURN
  420.           ENDIF
  421.     ;
  422.     ;    Catch Alt'd 1234567890-
  423.     ;
  424.        IF FIND "1234567890-" S0(3) N0
  425.           ITOC (0x78+N0) S0(1)
  426.           ITOC 0 S0
  427.           N0 = 2
  428.           RETURN
  429.           ENDIF
  430.     ;
  431.     ;    Other Alt's are errors
  432.     ;
  433.        SET FLAG(0) ON
  434.        RETURN
  435.        ENDIF
  436. ;
  437. ;    Now, 'SF10', 'CF10' 'AF10' and '^F10'
  438. ;
  439.     IF FIND "F10" S0(1:3)           ; Last 3 chars are F10
  440.        FIND "SCA^" S0(0:0) N0
  441.        SWITCH N0
  442.           CASE 0        ; AF0,AF1...
  443.         ITOC 0x5D S0(1)
  444.           ENDCASE
  445.           CASE 1        ; CF0,CF1...
  446.         ITOC 0x67 S0(1)
  447.           ENDCASE
  448.           CASE 2        ; AF0,AF1...
  449.         ITOC 0x71 S0(1)
  450.           ENDCASE
  451.           CASE 3        ; ^F0,^F1...
  452.         ITOC 0x67 S0(1)
  453.           ENDCASE
  454.           DEFAULT
  455.         SET FLAG(0) ON
  456.         RETURN
  457.           ENDCASE
  458.        ENDSWITCH
  459.     ;
  460.     ;    Return with the goods
  461.     ;
  462.        ITOC 0 S0
  463.        N0 = 2
  464.        RETURN
  465.        ENDIF
  466. ;
  467. ;    Finally, Catch 'home', 'Pgup', 'PgDn', CURL', 'CURR', 'BELL' ,'^END'
  468. ;
  469.     SWITCH S0
  470.        CASE "^END"          ; Ctl-Endkey
  471.           ITOC 0x75 S0(1)
  472.           ITOC 0 S0
  473.           N0 = 2
  474.           RETURN
  475.        ENDCASE
  476.        CASE "HOME"          ; Homekey
  477.           ITOC 0x47 S0(1)
  478.           ITOC 0 S0
  479.           N0 = 2
  480.           RETURN
  481.        ENDCASE
  482.        CASE "PGUP"          ; PgDnkey
  483.           ITOC 0x49 S0(1)
  484.           ITOC 0 S0
  485.           N0 = 2
  486.           RETURN
  487.        ENDCASE
  488.        CASE "PGDN"          ; PgUpkey
  489.           ITOC 0x51 S0(1)
  490.           ITOC 0 S0
  491.           N0 = 2
  492.           RETURN
  493.        ENDCASE
  494.        CASE "CURL"          ; Cursor left
  495.           ITOC 0x4B S0(1)
  496.           ITOC 0 S0
  497.           N0 = 2
  498.           RETURN
  499.        ENDCASE
  500.        CASE "CURR"          ; Cursor right
  501.           ITOC 0x4D S0(1)
  502.           ITOC 0 S0
  503.           N0 = 2
  504.           RETURN
  505.        ENDCASE
  506.        CASE "BELL"          ; Bell char
  507.           ITOC 7 S0
  508.           N0 = 1
  509.           RETURN
  510.        ENDCASE
  511.        CASE "NULL"          ; Alt-NumKeyPad-0
  512.           ITOC 3 S0(1)
  513.           ITOC 0 S0
  514.           N0 = 2
  515.           RETURN
  516.        ENDCASE
  517.     ENDSWITCH
  518. ;
  519. ;    Others are errors
  520. ;
  521.     SET FLAG(0) ON        ; Others are errors
  522.     RETURN
  523. ;
  524. ; ***** Five character keycode here; First, catch AltF1-AltF9
  525. ;
  526. TEKE500:
  527.     UPPER S0
  528.     IF FIND "ALT" S0(0:2)   ; Case insensitive test
  529.        IF FIND "F1,F2,F3,F4,F5,F6,F7,F8,F9" S0(3:4) N0
  530.           IF NE (N0\3) 0       ; Modulo divide (remainder)
  531.          SET FLAG(0) ON    ; .. catch e.g. "0,"
  532.          RETURN
  533.          ENDIF
  534.           ITOC 0 S0
  535.           ITOC (0x68+N0/3) S0(1)
  536.           N0 = 2
  537.           RETURN
  538.           ENDIF
  539.     ;
  540.     ;     Catch AltEq here (syntax doesn't allow Alt=)
  541.     ;
  542.         IF FIND "EQ" S0(3:4)
  543.           ITOC 0 S0
  544.           ITOC (0x83+N0/3) S0(1)
  545.           N0 = 2
  546.           RETURN
  547.           ENDIF
  548.     ;
  549.     ;    Other Alt's are errors
  550.     ;
  551.        SET FLAG(0) ON
  552.        RETURN
  553.        ENDIF
  554. ;
  555. ;    Catch "^Home", "^PgUp", "^PgDn" "^CurR", "^CurL", "CurUp" and "CurDn"
  556. ;
  557.     SWITCH S0
  558.        CASE "^HOME"         ; Ctl-Homekey
  559.           ITOC 0x77 S0(1)
  560.           ITOC 0 S0
  561.           N0 = 2
  562.           RETURN
  563.        ENDCASE
  564.        CASE "^PGUP"         ; Ctl-PgDnkey
  565.           ITOC 0x84 S0(1)
  566.           ITOC 0 S0
  567.           N0 = 2
  568.           RETURN
  569.        ENDCASE
  570.        CASE "^PGDN"         ; Ctl-PgUpkey
  571.           ITOC 0x76 S0(1)
  572.           ITOC 0 S0
  573.           N0 = 2
  574.           RETURN
  575.        ENDCASE
  576.        CASE "^CURL"         ; Cursor left
  577.           ITOC 0x73 S0(1)
  578.           ITOC 0 S0
  579.           N0 = 2
  580.           RETURN
  581.        ENDCASE
  582.        CASE "^CURR"         ; Cursor right
  583.           ITOC 0x74 S0(1)
  584.           ITOC 0 S0
  585.           N0 = 2
  586.           RETURN
  587.        ENDCASE
  588.        CASE "CURDN"         ; Cursor down
  589.           ITOC 0x50 S0(1)
  590.           ITOC 0 S0
  591.           N0 = 2
  592.           RETURN
  593.        ENDCASE
  594.        CASE "CURUP"         ; Cursor up
  595.           ITOC 0x48 S0(1)
  596.           ITOC 0 S0
  597.           N0 = 2
  598.           RETURN
  599.        ENDCASE
  600.     ENDSWITCH
  601. ;
  602. ;    Others are errors
  603. ;
  604.     SET FLAG(0) ON        ; Others are errors
  605.     RETURN
  606. ;
  607. ; ***** Six character keycode here
  608. ;    .. Catch 'AltF10', '^PrtSc'
  609. ;
  610. TEKE600:
  611.     SWITCH S0
  612.        CASE "AltF10"        ; Alt'd F10
  613.           ITOC 0x71 S0(1)
  614.           ITOC 0 S0
  615.           N0 = 2
  616.           RETURN
  617.        ENDCASE
  618.        CASE "^PRTSC"        ; Ctl-PrtSc
  619.           ITOC 0x72 S0(1)
  620.           ITOC 0 S0
  621.           N0 = 2
  622.           RETURN
  623.        ENDCASE
  624.        CASE "RevTab"        ; Reverse tab
  625.           ITOC 0x0f S0(1)
  626.           ITOC 0 S0
  627.           N0 = 2
  628.           RETURN
  629.        ENDCASE
  630.     ENDSWITCH
  631. ;
  632. ;    Others are errors
  633. ;
  634.     SET FLAG(0) ON        ; Others are errors
  635.     RETURN
  636. ;
  637. ;    Escape during "compile" window
  638. ;    .. wait for a second esc
  639. ;
  640. CompEsc:
  641.     IF FLAG(9)
  642.        SET FLAG(9) OFF
  643.        RETURN
  644.        ENDIF
  645.     MESS "^M^JEsc pressed^M^JPress any key again to continue^M^J"
  646.     SET FLAG(9) ON
  647. Hang:
  648.     IF FLAG(9)
  649.        GOTO Hang
  650.        ENDIF
  651.     RETURN
  652. ;
  653. ; ----- Subroutine: Scan the input file for sections
  654. ;    If sections found, ask for a selection
  655. ;    Return:   FLAG(0) <- TRUE if use ESC'd
  656. ;          FLAG(0) <- FALSE -> File positioned for start
  657. ;          N97 -> THe number of "NAME" commands to pass by
  658. ;
  659. Select:
  660.     N97 = 1         ; Default one
  661.     N10 = 0         ; # of sections found
  662.     SET FLAG(1) OFF     ; F -> Nothing compilable preceding 1st section
  663.     WOPEN 10,1  12,78 (default) ErrEsc
  664.     ATSAY 10,3  (default) " Select section "
  665.     ATSAY 11,3  (default) "Scanning for sections in the source file..."
  666.     ATSAY 12,30 (default) " ESC ends script "
  667. ;
  668. ;    Save the current position, and read a line
  669. ;
  670. SELE100:
  671.     FSAVEI            ; Save current position
  672.     READ S0 80 N0        ; Len read into N0
  673.     IF EOF
  674.        FSAVEI POP        ; Throw away the EOF position
  675.        GOTO End_Select
  676.        ENDIF
  677. ;
  678. ;    Catch comments here (note save-stack pops)
  679. ;
  680.     IF NULL S0
  681.        FSAVEI POP        ; Throw away saved position
  682.        GOTO SELE100
  683.        ENDIF
  684.     LJ S0            ; Left justify
  685.     IF STRCMP S0(0:0) ";" or STRCMP S0(0:0) "*"
  686.        FSAVEI POP        ; Throw away saved position
  687.        GOTO SELE100
  688.        ENDIF
  689. ;
  690. ;    Extract the 1st field into S1
  691. ;
  692.     FIND S0 "=" N1          ; Find an '=' sign
  693.     S1 = S0(0:N1-1)     ; Extract keycode
  694.     LJ S1
  695.     IF EQ N1 0 or NULL S1    ; = in col 0, or empty keycode
  696.        FSAVEI POP        ; Throw away saved position
  697.        GOTO SELE100
  698.        ENDIF
  699. ;
  700. ;    The section heading, (NAME = ...) terminates I/O
  701. ;
  702.     IF NOT FIND S1(0:3) "NAME"  ; Case insensitive test
  703.        FSAVEI POP        ; Throw away saved position
  704.        IF ZERO N10        ; Not in a section
  705.           SET FLAG(1) ON    ; Mark a compilable line in unnamed section
  706.           ENDIF
  707.        GOTO SELE100     ; Skip if not section cmd
  708.        ENDIF
  709. ;
  710. ;    Extract the operand field
  711. ;
  712.     S2 = S0(N1+1:79)    ; Extract section name
  713.     LJ S2
  714. ;
  715. ;    We have found a section command - if the first - open a window
  716. ;
  717.     IF NOT ZERO N10     ; Test if already found a section
  718.        GOTO SELE200     ; SKip if window is open
  719.        ENDIF
  720.  
  721.     WCLOSE            ; Close open window (scanning...)
  722.     WOPEN 0 ,10 19,70 (default)
  723.     ATSAY 0 ,12 (default) " Remap Select "
  724.     ATSAY 1 ,11 (default)  " The source file contains multiple sections.  These are:   "
  725.     ATSAY 2 ,12 (default)  " 1)"
  726.     ATSAY 3 ,12 (default)  " 2)"
  727.     ATSAY 4 ,12 (default)  " 3)"
  728.     ATSAY 5 ,12 (default)  " 4)"
  729.     ATSAY 6 ,12 (default)  " 5)"
  730.     ATSAY 7 ,12 (default)  " 6)"
  731.     ATSAY 8 ,12 (default)  " 7)"
  732.     ATSAY 9 ,12 (default)  " 8)"
  733.     ATSAY 10,12 (default)  " 9)"
  734.     ATSAY 11,12 (default)  " 10)"
  735.     ATSAY 12,12 (default)  " 11)"
  736.     ATSAY 13,12 (default)  " 12)"
  737.     ATSAY 14,12 (default)  " 13)"
  738.     ATSAY 15,12 (default)  " 14)"
  739.     ATSAY 16,12 (default)  " 15)"
  740.     ATSAY 17,10 (default) "├───────────────────────────────────────────────────────────┤"
  741.     ATSAY 18,12 (default) "Select (1-10):"
  742.     ATSAY 19 32 (default) " Press ESC to exit "
  743. ;
  744. ;    If there's an initial unnamed section, name it
  745. ;
  746.     IF NOT FLAG(1)        ; If not compilable source before section...
  747.        GOTO SELE200     ; .. skip this
  748.        ENDIF
  749.     ATSAY N10+2,16 (default) "Unnamed 1st section"
  750.     INC N10
  751. ;
  752. ;    Add the section name to the list
  753. ;
  754. SELE200:
  755.     IF NULL S2
  756.        S2 = "Unnamed section #"&N10
  757.        ENDIF
  758.     ATSAY N10+2,16 (default) S2(0:48)
  759.     INC N10
  760.     IF LT N10 15        ; Allow up to 15 sections
  761.        GOTO SELE100
  762.        ENDIF
  763. ;
  764. ;    End of file scan - ask for a selection if there're sections
  765. ;
  766. End_Select:
  767.     IF ZERO N10 or EQ N10 1 ; No sections found or only one
  768.        REWIND        ; Rewind input file
  769.        SET FLAG(0) OFF    ; Return O-K
  770.        WCLOSE        ; Close 'scanning...' window
  771.        RETURN
  772.        ENDIF
  773. ;
  774. ;    Prompt for a selection
  775. ;
  776. ENSE100:
  777.     MESS "^G"
  778.     ATGET 18,27 (default) 2 S0
  779.     IF NULL S0
  780.        SET FLAG(0) ON
  781.        ENDIF
  782. ;
  783. ;    Interpret the response
  784. ;
  785.     ATOI S0 N0
  786.     IF LT N0 1 or GT N0 N10
  787.        SOUND 100,100
  788.        GOTO ENSE100
  789.        ENDIF
  790. ;
  791. ;    Use the selected # to pop the save stack
  792. ;
  793.     WCLOSE            ; Close 'select window'
  794.     WHILE LE N0 N10
  795.        FRESTOREI        ; Move back through saved positions
  796.        DEC N10        ; .. and decremnet index
  797.        ENDWHILE
  798.     IF EQ N0 1 and FLAG(1)    ; There was an unnamed section and we want it
  799.        REWIND        ; .. move to beginning of file
  800.        N97 = 0        ; Pass by no NAME commands
  801.        ENDIF
  802. ;
  803. ;    And return positioned OK
  804. ;
  805.     SET FLAG(0) OFF
  806.     FSAVEI CLEAR
  807.     RETURN
  808. ;
  809. ; ----- Subroutine Syntax check a source file
  810. ;
  811. Syntax:
  812.     SET FLAG(8) ON
  813.     GOTO Start
  814. ;
  815. ; ----- Subroutine Compile: compile a source file into COM-AND.RMP
  816. ;
  817. Compile:
  818.     SET FLAG(8) OFF     ; Turnoff syntax check
  819.     SET FLAG(9) OFF     ; ESC during compile
  820. ;
  821. ; ----- Start compilation
  822. ;
  823. Start:
  824.     WOPEN 10,1, 13,77 (contrast) ErrEsc
  825.     ATSAY 11, 3 (contrast) "Enter the source file name (with or without path/drive)."
  826.     ATSAY 12, 3 (contrast) "-> "
  827.     ATSAY 13,29 (contrast) " Press ESC to cancel "
  828. ;
  829. ;    Ask for a file name
  830. ;
  831.     ATGET 12, 7 (contrast) 60 S0    ; Get source file name
  832.     WCLOSE            ; Restore screen under
  833.     IF NULL S0
  834.        RETURN        ; End here
  835.        ENDIF
  836. ;
  837. ;    Attempt to open the given file
  838. ;
  839.     IF NOT ISFILE S0
  840.        S1 = S0
  841.        S0 = "File does not exist (or cannot be opened)"
  842.        GOSUB Error
  843.        GOTO Compile     ; Try again
  844.        ENDIF
  845.     FOPENI S0 TEXT        ; Try to open as text
  846.     IF FAILURE
  847.        S1 = S0
  848.        S0 = "Source file cannot be opened"
  849.        GOSUB Error
  850.        GOTO Compile     ; Try again
  851.        ENDIF
  852.     S18 = S0        ; Save open file name
  853. ;
  854. ;    Scan the file for 'section' names... if found, ask for a selection
  855. ;    On return, if FLAG(0) reset (off), file is positioned for I/O
  856. ;           Else, user ESC'd
  857. ;
  858.     GOSUB Select
  859.     IF FLAG(0)
  860.        RETURN
  861.        ENDIF
  862. ;
  863. ;    Open (and purge) the output file
  864. ;
  865.     IF NOT FLAG(8)        ; If not syntax check
  866.        FOPENO S19 BINARY
  867.        IF FAILURE
  868.           S1 = S0
  869.           S0 = "Target file cannot be opened"
  870.           GOSUB Error
  871.           RETURN        ; Error fatal to this subroutine
  872.           ENDIF
  873.        ENDIF
  874. ;
  875. ;    Set a display window for compilation
  876. ;
  877.     WOPEN 5,15 20,65 (contrast) CompESC
  878.     ATSAY 5,17 (contrast) " Remap compilation "
  879.     ATSAY 20,30 (contrast) " Press ESC to pause "
  880.     DWINDOW 6,17 19,63    ; Actual scrolling region
  881.     CLEAR            ; Clear the whole region
  882. ;
  883. ;    Other initialization
  884. ;
  885.     N99 = 0         ; # errors
  886.     N98 = 0         ; Output file size
  887.     SET FLAG(9) OFF     ; Escape during compile
  888. ;
  889. ; ***** Read a line and display it
  890. ;    N99 -----> Counts the # errors
  891. ;
  892. Loop:
  893.     READ S0 80 N0        ; Len read into N0
  894.     IF EOF
  895.        GOTO End_Compile
  896.        ENDIF
  897.     S1 = S0         ; Replicate
  898.     PRESERVE S1        ; Keep bangs and carets
  899.     MESS S1         ; Display the line (just as read)
  900. ;
  901. ;    Catch comments here
  902. ;
  903.     IF NULL S0
  904.        GOTO LOOP
  905.        ENDIF
  906.     LJ S0            ; Left justify
  907.     IF STRCMP S0(0:0) ";" or STRCMP S0(0:0) "*"
  908.        GOTO LOOP
  909.        ENDIF
  910. ;
  911. ;    Extract the keycode into S1
  912. ;
  913.     FIND S0 "=" N1          ; Find an '=' sign
  914.     S1 = S0(0:N1-1)     ; Extract keycode
  915.     LJ S1
  916.     IF EQ N1 0 or NULL S1    ; = in col 0, or empty keycode
  917.        MESS "*** Missing keycode ***"
  918.        INC N99        ; Count the error
  919.        GOTO Loop
  920.        ENDIF
  921. ;
  922. ;    The 2nd time we hit a section heading, (NAME = ...) make an EOF
  923. ;
  924.     IF FIND S1(0:3) "NAME"  ; Case insensitive test
  925.        IF ZERO N97        ; # NAME = lines found so far
  926.           GOTO End_Compile    ; pseudo EOF
  927.           ENDIF
  928.        DEC N97        ; Pass this one by, byt count it
  929.        GOTO Loop        ; Throw away 1st
  930.        ENDIF
  931. ;
  932. ;    Extract the operand into S2
  933. ;
  934.     S2 = S0(N1+1:79)    ; Extract operand
  935.     LJ S2
  936.     IF NULL S2        ; Empty assignment
  937.        MESS "*** Missing assignment ***"
  938.        INC N99        ; Count the error
  939.        GOTO Loop
  940.        ENDIF
  941. ;
  942. ;    Look at the keycode in S1
  943. ;
  944.     S0 = S1         ; Parameter passed
  945.     GOSUB Keycode
  946.     IF FLAG(0)
  947.        MESS "*** Invalid keycode ***"
  948.        INC N99        ; Count the error
  949.        GOTO Loop
  950.        ENDIF
  951.     S3 = S0         ; Keep converted value
  952.     N3 = N0         ; Keep length of conversion so far
  953. ;
  954. ;    Initialize the output operand
  955. ;
  956.     S4 = ""                 ; Nake it null
  957.     N4 = 0            ; Length so far
  958. ;
  959. ; ***** Now - begin handling the operand
  960. ;
  961. LOOP100:
  962.     LJ S2            ; Throw away leading blanks
  963.     IF NULL S2
  964.        GOTO LOOP300     ; When its null, end of operand
  965.        ENDIF
  966.  
  967.     IF STRCMP "," S2(0:0)   ; Look for a leading comma
  968.        S2 = S2(1:79)    ; Throw away comma
  969.        GOTO LOOP100     ; And continue
  970.        ENDIF
  971. ;
  972. ;    Catch quotes here
  973. ;
  974.     IF STRCMP "`"" S2(0:0)  ; Look for a leading double quote
  975.        GOTO LOOP200     ; Handle it specially in operand
  976.        ENDIF
  977. ;
  978. ;    ";" terminator allows comments in-line
  979. ;
  980.     IF STRCMP ";"  S2(0:0)  ; Look for a leading semi-colon
  981.        GOTO LOOP300     ; Treat as-if end of line
  982.        ENDIF
  983. ;
  984. ;    Parse out something
  985. ;
  986.     FIND S2 " " N5          ; Find position of next blank
  987.     FIND S2 "," N6          ; Find position of next comma
  988.     IF EQ N6 N5        ; Both -1 if neither found
  989.        S0 = S2        ; Neither a ' ' or ',' - use whole string
  990.        S2 = ""              ; Null remaining operand
  991.     ELSE
  992.        IF EQ N6 -1        ; use N5
  993.        ELSE
  994.           IF EQ N5 -1 or LT N6 N5
  995.          N5 = N6    ; Set N5 to smaller legit value
  996.          ENDIF
  997.           ENDIF
  998.        S0 = S2(0:N5-1)    ; Extract what we found
  999.        S2 = S2(N5+1:79)    ; And remove it from the string
  1000.        ENDIF
  1001. ;
  1002. ;    One keycode is an operand only... handle it
  1003. ;
  1004.     IF FIND S0(0:5) "Functn"; Special function
  1005.        ITOC 0 S4(N4)
  1006.        ITOC 0x80 S4(N4+1)    ; Made-up extended code for COM-AND
  1007.        N4 = N4+2
  1008.        GOTO LOOP100
  1009.        ENDIF
  1010. ;
  1011. ;    Test for a token
  1012. ;
  1013.     GOSUB Keycode
  1014.     IF FLAG(0)
  1015.        MESS "*** Invalid code in operand ***"
  1016.        INC N99        ; Count the error
  1017.        GOTO Loop
  1018.        ENDIF
  1019. ;
  1020. ;    Test for a circular definition
  1021. ;
  1022.     IF N0 eq 2 AND STRCMP S3(1) S0(1)
  1023.        MESS "*** Remap would be circular ***"
  1024.        INC N99        ; Count the error
  1025.        GOTO Loop
  1026.        ENDIF
  1027. ;
  1028. ;    Add the non-ascii key to the operand
  1029. ;
  1030.     CONCAT S4(N4) S0(0:N0-1); Concatenate converted string into S4
  1031.     N4 = N4+N0        ; Keep length of conversion so far
  1032.     GOTO LOOP100
  1033. ;
  1034. ; ***** Handle a quoted string in the operand here
  1035. ;
  1036. LOOP200:
  1037.     S2 = S2(1:79)        ; Eliminate leading char
  1038.     IF NULL S2        ; Missing terminating ""
  1039.        MESS "*** Invalid quoted string ***"
  1040.        INC N99        ; Count the error
  1041.        GOTO Loop
  1042.        ENDIF
  1043.  
  1044.     IF STRCMP S2(0:0) "`""  ; If we find a second ""
  1045.        S2 = S2(1:79)    ; .. Eliminate it
  1046.        GOTO LOOP100     ; .. and continue
  1047.        ENDIF
  1048.  
  1049.     IF STRCMP S2(0:0) "^^"
  1050.        S2 = S2(1:79)    ; Eliminate leading caret
  1051.        IF STRCMP S2(0:0) "^^"
  1052.           CONCAT S4(N4) "^^"; ^^ -> ^ in output
  1053.           N4 = N4+1     ; Keep length of conversion so far
  1054.           GOTO LOOP200
  1055.        ELSE
  1056.           S5 = S2(0:0)    ; Take just 1st char
  1057.           UPPER S5        ; Upper case it alone
  1058.           CTOI S5 N5
  1059.           ITOC (N5-64) S4(N4)
  1060.           N4 = N4+1     ; Keep length of conversion so far
  1061.           GOTO LOOP200
  1062.           ENDIF
  1063.        ENDIF
  1064.  
  1065.     IF STRCMP S2(0:0) "!!"  ; DOn't want STRCMP to collapse it
  1066.        IF STRCMP S2(1:1) "!!"
  1067.           S2 = S2(1:79)    ; Eliminate leading bang
  1068.           CONCAT S4(N4) "!!"; !! -> ! in output
  1069.           N4 = N4+1     ; Keep length of conversion so far
  1070.           GOTO LOOP200
  1071.        ELSE
  1072.           ITOC 13 S4(N4)    ; Else "!" -> C/r
  1073.           N4 = N4+1     ; Keep length of conversion so far
  1074.           GOTO LOOP200
  1075.           ENDIF
  1076.        ENDIF
  1077.  
  1078.     IF STRCMP S2(0:0) "``"
  1079.        S2 = S2(1:79)    ; Eliminate leading grave
  1080.        IF NULL S2        ; Ignore final grave...
  1081.           GOTO LOOP200
  1082.           ENDIF
  1083.        ENDIF
  1084.  
  1085.     CTOI S2 N5        ; Take char as-is
  1086.     ITOC N5 S4(N4)
  1087.     N4 = N4+1
  1088.     GOTO LOOP200
  1089. ;
  1090. ; ***** Look for an empty operand
  1091. ;    N3 -> The length of the keycode (1,2) in S3
  1092. ;    N4 -> The length of the operand       in S4
  1093. ;
  1094. LOOP300:
  1095.     IF LE N4 0
  1096.        MESS "*** Empty operand out ***"
  1097.        INC N99        ; Count the error
  1098.        GOTO Loop
  1099.        ENDIF
  1100. ;
  1101. ; ***** Write the remap to disk
  1102. ;
  1103.     N98 = N98+N3+1+N4    ; Track output file size
  1104.     IF LE N98 768        ; Do not write too much
  1105.        IF NOT FLAG(8)    ; IF table size OK, and not syntax
  1106.           ITOC N4 S5    ; Move len to a char string
  1107.           WRITE S3 N3    ; Write keycode
  1108.           WRITE S5 1    ; Write 1 byte length
  1109.           WRITE S4 N4    ; And write the operand
  1110.           ENDIF
  1111.     ELSE
  1112.        MESS "*** Output max size exceeded ***"
  1113.        INC N99        ; Count the error
  1114.        ENDIF
  1115.     GOTO Loop
  1116. ;
  1117. ;    End of compilation - clear the window limits and close output
  1118. ;
  1119. End_Compile:
  1120.     DWINDOW CLEAR        ; CLEAR THE display window
  1121.     FCLOSEO         ; CLose the output (OK if not open)
  1122.     FCLOSEI         ; CLose the input
  1123. ;
  1124. ;    Open a descriptive window
  1125. ;
  1126.     WOPEN 10,1, 14,77 (contrast) ErrEsc
  1127.     ATSAY 11, 3 (contrast) "The output file is "*N98*" bytes"
  1128.     ATSAY 12, 3 (contrast) "There were "*N99*" errors"
  1129.     IF GT N98 768
  1130.        ATSAY 13,3 (contrast) "Warning: ^GThe output file was truncated to the maximum allowed"
  1131.        ENDIF
  1132.     ATSAY 14,26 (contrast) " Press any key to continue "
  1133.     KEYGET S0        ; Wait for any key
  1134.     WCLOSE            ; Restore screen under
  1135. ;
  1136. ;    Drop the Final window and we're done
  1137. ;
  1138.     WCLOSE
  1139.     RETURN
  1140. ;
  1141. ; ----- Open a window and display a menu
  1142. ;
  1143. Window:
  1144.     WOPEN 0 ,10 19,70 (default)
  1145.     ATSAY 0 ,12 (default) " COM-AND Remapping "
  1146.     ATSAY 1 ,11 (default)  " COM-AND version 2.4 allows the keyboard to be remapped.   "
  1147.     ATSAY 2 ,11 (default)  " Any keystroke COM-AND can detect (it cannot detect all)   "
  1148.     ATSAY 3 ,11 (default)  " may be assigned to another key or keys.  Macros may be    "
  1149.     ATSAY 4 ,11 (default)  " created using this facility, as well as simple remaps.    "
  1150.  
  1151.     ATSAY 6 ,11 (default)  " Source text files are created indpendantly and compiled   "
  1152.     ATSAY 7 ,11 (default)  " with this script into the COM-AND.RMP file for use.       "
  1153.  
  1154.     ATSAY 8 ,10 (default) "├───────────────────────────────────────────────────────────┤"
  1155.     ATSAY 9  12 (default) "1) Compile source into a new remap"
  1156.     ATSAY 10 12 (default) "2) Syntax check a source file"
  1157.     ATSAY 11 12 (default) "3) Search for files (Alt-F)"
  1158.     ATSAY 12 12 (default) "4) Edit a file (you supply the editor)"
  1159.     ATSAY 13 12 (default) "5) Turn remap on (using current map)"
  1160.     ATSAY 14 12 (default) "6) Turn remap off"
  1161.     ATSAY 15,10 (default) "├───────────────────────────────────────────────────────────┤"
  1162.     ATSAY 16,12 (default) "Output: "*S19(0:48)
  1163.     ATSAY 17,10 (default) "├───────────────────────────────────────────────────────────┤"
  1164.     ATSAY 18,12 (default) "Select:"
  1165.     ATSAY 19 32 (default) " Press ESC to exit "
  1166.     RETURN
  1167.